home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Delphi 5 Companion Tools CD / FreeWare / HVDLL / HVDLL.ZIP / TestImpUnit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-08-04  |  4.3 KB  |  156 lines
  1. unit TestImpUnit;
  2. { This is the unit for the form that tests the different methods
  3.   of importing DLL routines }
  4. interface
  5.  
  6. uses
  7.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  8.   StdCtrls,
  9.   HVDll, ExtCtrls;
  10.  
  11. type
  12.   TDllImportTestForm = class(TForm)
  13.     rgImportMethod: TRadioGroup;
  14.     gbCallProcs: TGroupBox;
  15.     btnRoutine1: TButton;
  16.     btnRoutine2: TButton;
  17.     btnRoutine3: TButton;
  18.     btnRoutine4: TButton;
  19.     gbLogging: TGroupBox;
  20.     LoggingMemo: TMemo;
  21.     gbHVDll: TGroupBox;
  22.     btnLoadDll: TButton;
  23.     btnUnloadDll: TButton;
  24.     btnHook: TButton;
  25.     btnUnhook: TButton;
  26.     procedure btnRoutine1Click(Sender: TObject);
  27.     procedure btnRoutine2Click(Sender: TObject);
  28.     procedure btnRoutine3Click(Sender: TObject);
  29.     procedure btnRoutine4Click(Sender: TObject);
  30.     procedure FormCreate(Sender: TObject);
  31.     procedure FormDestroy(Sender: TObject);
  32.     procedure btnUnloadDllClick(Sender: TObject);
  33.     procedure btnLoadDllClick(Sender: TObject);
  34.     procedure btnHookClick(Sender: TObject);
  35.     procedure btnUnhookClick(Sender: TObject);
  36.   private
  37.     procedure DllNotify(Sender: TDll; Action: TDllNotifyAction; Index: integer);
  38.     procedure Log(const Msg: string; Args: array of const);
  39.   end;
  40.  
  41. var
  42.   DllImportTestForm: TDllImportTestForm;
  43.  
  44. implementation
  45.  
  46. {$R *.DFM}
  47. uses
  48.   ImpImpTestDll,
  49.   ExpImpTestDll,
  50.   DynLinkTest;
  51.  
  52. const
  53.   ImplicitIdx = 0;
  54.   ExplicitIdx = 1;
  55.   HVDllIdx    = 2;
  56.  
  57. procedure TDllImportTestForm.FormCreate(Sender: TObject);
  58. begin
  59.   Dlls.OnDllNotify := Self.DllNotify;
  60. end;
  61.  
  62. procedure TDllImportTestForm.FormDestroy(Sender: TObject);
  63. begin
  64.   Dlls.OnDllNotify := nil;
  65. end;
  66.  
  67. procedure TDllImportTestForm.btnRoutine1Click(Sender: TObject);
  68. begin
  69.   case rgImportMethod.ItemIndex of
  70.     ImplicitIdx : ImpImpTestDll.Routine1(1, 11, 111, 1111);
  71.     ExplicitIdx : ExpImpTestDll.Routine1(1, 11, 111, 1111);
  72.     HVDllIdx    : DynLinkTest  .Routine1(1, 11, 111, 1111);
  73.   end;
  74. end;
  75.  
  76. procedure TDllImportTestForm.btnRoutine2Click(Sender: TObject);
  77. begin
  78.   case rgImportMethod.ItemIndex of
  79.     ImplicitIdx : ImpImpTestDll.Routine2(2, 22, 222, 2222);
  80.     ExplicitIdx : ExpImpTestDll.Routine2(2, 22, 222, 2222);
  81.     HVDllIdx    : DynLinkTest  .Routine2(2, 22, 222, 2222);
  82.   end;
  83. end;
  84.  
  85. procedure TDllImportTestForm.btnRoutine3Click(Sender: TObject);
  86. begin
  87.   case rgImportMethod.ItemIndex of
  88.     ImplicitIdx : ImpImpTestDll.Routine3(3, 33, 333, 3333);
  89.     ExplicitIdx : ExpImpTestDll.Routine3(3, 33, 333, 3333);
  90.     HVDllIdx    : DynLinkTest  .Routine3(3, 33, 333, 3333);
  91.   end;
  92. end;
  93.  
  94. procedure TDllImportTestForm.btnRoutine4Click(Sender: TObject);
  95. begin
  96.   case rgImportMethod.ItemIndex of
  97.     ImplicitIdx : ImpImpTestDll.Routine4(4, 44, 444, 4444);
  98.     ExplicitIdx : ExpImpTestDll.Routine4(4, 44, 444, 4444);
  99.     HVDllIdx    : DynLinkTest  .Routine4(4, 44, 444, 4444);
  100.   end;
  101. end;
  102.  
  103. procedure TDllImportTestForm.Log(const Msg: string; Args: array of const);
  104. begin
  105.   LoggingMemo.Lines.Add(Format(Msg, Args));
  106. end;
  107.  
  108. procedure TDllImportTestForm.DllNotify(Sender: TDll; Action: TDllNotifyAction; Index: integer);
  109. begin
  110.   case Action of
  111.     daLoadedDll:     Log('Loaded %s', [Sender.FullPath]);
  112.     daUnloadedDll:   Log('Unloaded %s', [Sender.FullPath]);
  113.     daLinkedRoutine: Log('Linked %s.%s', [Sender.FullPath, Sender.EntryName[Index]]);
  114.   end;
  115. end;
  116.  
  117. procedure TDllImportTestForm.btnUnloadDllClick(Sender: TObject);
  118. begin
  119.   TestDll.Unload;
  120. end;
  121.  
  122. procedure TDllImportTestForm.btnLoadDllClick(Sender: TObject);
  123. begin
  124.   TestDll.Load;
  125. end;
  126.  
  127. var
  128.   OldRoutine1 : procedure (A, B, C, D: integer); register;
  129.  
  130. procedure HookedRoutine1(A, B, C, D: integer); register;
  131. begin
  132.   DllImportTestForm.Log('Hooked Routine1 before (%d, %d, %d, %d)', [A, B, C, D]);
  133.   OldRoutine1(A+1, B+1, C+1, D+1);
  134.   DllImportTestForm.Log('Hooked Routine1 after (%d, %d, %d, %d)', [A, B, C, D]);
  135. end;
  136.  
  137. procedure TDllImportTestForm.btnHookClick(Sender: TObject);
  138. begin
  139.   if TestDll.HookRoutine(@@DynLinkTest.Routine1, @HookedRoutine1, OldRoutine1) then
  140.   begin
  141.     btnHook.Enabled := false;
  142.     btnUnhook.Enabled := true;
  143.   end;
  144. end;
  145.  
  146. procedure TDllImportTestForm.btnUnhookClick(Sender: TObject);
  147. begin
  148.   if TestDll.UnHookRoutine(@@DynLinkTest.Routine1, OldRoutine1) then
  149.   begin
  150.     btnHook.Enabled := true;
  151.     btnUnhook.Enabled := false;
  152.   end;
  153. end;
  154.  
  155. end.
  156.